home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 476-500 / disk_499 / diglib / diglib.lzh / source / gsfill.for < prev    next >
Text File  |  1991-05-01  |  6KB  |  195 lines
  1.         SUBROUTINE GSFILL(X,Y,N,TX,TY)
  2.         IMPLICIT NONE
  3.         REAL*4 X(N),Y(N), TX(N),TY(N)
  4. C
  5. C       DIGLIB POLYGON FILL SUPPORT
  6. C       DERIVED FROM "HATCH" ALGORITHM BY KELLY BOOTH
  7. C
  8.         INCLUDE DIGLIB$KOM:GCDCHR.PRM
  9.         INCLUDE DIGLIB$KOM:GCDPRM.PRM
  10.         INCLUDE DIGLIB$KOM:GCLTYP.PRM
  11. C
  12.         REAL*4 XINS(40),FACT,YMAP,XMIN,YMIN,XMAX,YMAX,DX1,DY1,DY
  13.         REAL*4 COSTH,DX2,DY2,A,YSCALE,DLINES,YSCAN,YBEGIN
  14.         REAL*4 XBEGIN,YEND,XKEY,TEMP,YY
  15.         COMMON /MAPCOM/ YSCALE
  16.  
  17.         INTEGER GSIVIS,I,J,NCHNGS,L,LINOLD,INISEC,IFIRST
  18.         LOGICAL LEFT
  19.     INTEGER*1 IAND
  20.         DATA FACT /16.0/
  21. C
  22. C
  23.         IF (N .LT. 3) RETURN
  24. C
  25. C
  26. C       CONVERT TO ABSOLUTE COORD.
  27. C
  28.         DO 10 I=1,N
  29.                 CALL GSRST(X(I),Y(I),TX(I),TY(I))
  30. 10              CONTINUE
  31.         CALL MINMAX(TY,N,YMIN,YMAX)
  32.         CALL MINMAX(TX,N,XMIN,XMAX)
  33. C
  34. C       IF CLIPPING NEEDED OR IF NO HARDWARE POLYGON FILL, USE SOFTWARE
  35. C
  36.         IF ((GSIVIS(XMIN,YMIN) .NE. 0) .OR.
  37.      1   (GSIVIS(XMAX,YMAX) .NE. 0) .OR.
  38.      2   (IAND(IDVBTS,256) .EQ. 0)) GO TO 200
  39. C
  40. C       IF CAN HANDLE CONCAVE POLYGONS, JUST CALL DRIVER
  41. C
  42.         IF ((IAND(IDVBTS,512) .EQ. 0) .OR.
  43.      1   (N .EQ. 3)) GO TO 150
  44. C
  45. C       IF HERE, DRIVER CAN HANDLE CONVEX NON-INTERSECTING POLYGONS ONLY,
  46. C        SO MAKE SURE THIS POLYGON IS CONVEX AND NON-SELF-INTERSECTING.
  47. C
  48.         DX1 = X(1)-X(N)
  49.         DY1 = Y(1)-Y(N)
  50. C       !OLD NON-ZERO DELTA-Y
  51.         DY = DY1
  52. C       NUMBER OF TIMES DELTA-Y CHANGES SIGN
  53.         NCHNGS = 0
  54.         L = 1
  55.         COSTH = 0.0
  56. 110     CONTINUE
  57. C
  58. C               CONVEXITY TEST
  59. C
  60.                 DX2 = X(L+1)-X(L)
  61.                 DY2 = Y(L+1)-Y(L)
  62.                 A = DX1*DY2-DX2*DY1
  63.                 IF (A*COSTH .LT. 0.0) GO TO 200
  64.                 IF (COSTH .EQ. 0.0) COSTH = A
  65. C
  66. C               SELF INTERSECTION CHECK - RELYS ON "CONVEXITY" CHECK
  67. C
  68.                 IF (DY .NE. 0.0) GO TO 120
  69.                         DY = DY2
  70.                         GO TO 130
  71. 120             CONTINUE
  72.                 IF (DY2*DY .GE. 0.0) GO TO 130
  73.                         DY = DY2
  74.                         NCHNGS = NCHNGS + 1
  75.                         IF (NCHNGS .GE. 3) GO TO 200
  76. 130             CONTINUE
  77.                 DX1 = DX2
  78.                 DY1 = DY2
  79.                 L = L + 1
  80.                 IF (L .LT. N) GO TO 110
  81. 150     CONTINUE
  82.         CALL GSDRVR(1024+N,TX,TY)
  83.         RETURN
  84. C
  85. C       **********
  86. C       SOFTWARE FILL
  87. C       **********
  88. C
  89. 200     CONTINUE
  90. C
  91. C       FILLING A POLYGON IS VERY SIMPLE IF AND ONLY IF THE VERTICES OF
  92. C        THE POLYGON NEVER LIE ON A SCAN LINE.   WE CAN FORCE THIS TO HAPPEN
  93. C        BY THE FOLLOWING TRICK: MAKE ALL VERTICES LIE JUST BARELY ABOVE
  94. C        THE SCAN LINE THEY SHOULD LIE ON.   THIS IS DONE BY MAPPING THE
  95. C        VERTICES TO A GRID THAT IS "FACT" TIMES THE DEVICE RESOLUTION,
  96. C        AND THEN DOUBLING THE GRID DENSITY, AND OFFSETTING THE VERTICES
  97. C        BY 1.   BECAUSE WE DO THIS, WE MUST OUTLINE THE POLYGON.
  98. C
  99. C       *******
  100. C
  101. C       FILL WITH SOLID LINES
  102. C
  103.         LINOLD = ILNTYP
  104.         ILNTYP = 1
  105. C
  106.         LEFT = .TRUE.
  107.         YSCALE = YS*YRES*FACT
  108.         DLINES = 2.0*FACT
  109.         CALL MINMAX(Y,N,YMIN,YMAX)
  110.         YMIN = AINT(YMAP(YMIN)/DLINES)*DLINES+DLINES
  111.         YMAX = AINT(YMAP(YMAX)/DLINES)*DLINES
  112.         YSCAN = YMIN
  113. 210     CONTINUE
  114.                 INISEC = 0
  115.                 IFIRST = 0
  116. C
  117. C               DO EACH SIDE OF THE POLYGON. PUT ANY X INTERSECTIONS
  118. C               WITH THE SCAN LINE Y=YSCAN IN XINS
  119. C
  120.                 YBEGIN = YMAP(Y(N))
  121.                 XBEGIN = X(N)
  122.                 DO 400 L = 1, N
  123.                   YEND = YMAP(Y(L))
  124.                   DY = YSCAN-YBEGIN
  125.                   IF (DY*(YSCAN-YEND) .GT. 0.0) GO TO 390
  126. C
  127. C                 INSERT AN INTERSECTION
  128. C
  129.                   INISEC = INISEC + 1
  130.                   XINS(INISEC) = DY*(X(L)-XBEGIN)/(YEND-YBEGIN)+XBEGIN
  131. C
  132. 390               CONTINUE
  133.                   YBEGIN = YEND
  134.                   XBEGIN = X(L)
  135. 400               CONTINUE
  136. C
  137. C               FILL IF THERE WERE ANY INTERSECTIONS
  138. C
  139.                 IF (INISEC .EQ. 0) GOTO 500
  140. C
  141. C               FIRST WE MUST SORT ON X INTERSECTION.
  142. C               USE BUBBLE SORT BECAUSE USUALLY ONLY 2.
  143. C               WHEN "LEFT" IS TRUE, ASCENDING SORT, FALSE IS DESCENDING SORT
  144. C
  145.                 DO 450 I =  1, INISEC-1
  146.                         XKEY = XINS(I)
  147.                         DO 430 J = I+1, INISEC
  148.                                 IF (.NOT. LEFT) GOTO 420
  149.                                 IF (XKEY .GE. XINS(J)) GO TO 430
  150. 410                             CONTINUE
  151.                                 TEMP = XKEY
  152.                                 XKEY = XINS(J)
  153.                                 XINS(J) = TEMP
  154.                                 GO TO 430
  155. 420                             IF (XKEY .GT. XINS(J)) GOTO 410
  156. 430                             CONTINUE
  157.                         XINS(I) = XKEY
  158. 450                     CONTINUE
  159. C
  160. C               DRAW FILL LINES NOW
  161. C
  162.                 YY = YSCAN/(2.0*YSCALE)
  163.                 DO 460 I = 1, INISEC, 2
  164.                         CALL GSMOVE(XINS(I),YY)
  165.                         CALL GSDRAW(XINS(I+1),YY)
  166. 460                     CONTINUE
  167. 500             CONTINUE
  168.         YSCAN = YSCAN + DLINES
  169.         LEFT = .NOT. LEFT
  170.         IF (YSCAN .LE. YMAX) GO TO 210
  171. C
  172. C       FINALLY, OUTLINE THE POLYGON
  173. C
  174.         CALL GSMOVE(X(N),Y(N))
  175.         DO 510 L=1,N
  176.                 CALL GSDRAW(X(L),Y(L))
  177. 510             CONTINUE
  178. C
  179. C       RESTORE LINE TYPE
  180. C
  181.         ILNTYP = LINOLD
  182.         RETURN
  183.         END
  184.  
  185. C       DEFINE ARITHMETIC STATEMENT FUNCTION TO MAPPING VERTICES
  186.  
  187.         REAL FUNCTION YMAP(YYY)
  188.         IMPLICIT NONE
  189.         REAL*4 YSCALE
  190.         COMMON /MAPCOM/ YSCALE
  191.         REAL*4 YYY
  192.         YMAP = 2.0*AINT(YSCALE*YYY+0.5)+1.0
  193.         RETURN
  194.         END
  195.